perm filename ANSWER.NEW[1,JRA]4 blob
sn#030165 filedate 1973-03-16 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP ALLPOS
00400 (LAMBDA (C) (LIST (QUOTE NULL) (LIST (QUOTE CADAR) (CADR C))))
00500 MACRO)
00600
00700 (DEFPROP ALLNEG
00800 (LAMBDA (C) (LIST (QUOTE EQ) (LIST (QUOTE CADAR) (CADR C)) (LIST (QUOTE CDR) (CADR C))))
00900 MACRO)
01000
01100 (DEFPROP ANCESTOR
01200 (LAMBDA (X) (LIST (QUOTE CDDDAR) (CADR X)))
01300 MACRO)
01400
01500 (DEFPROP SEARCH1
01600 (LAMBDA (X) (LIST (QUOTE SEARCH2) (CADR X) (CADDR X) NIL))
01700 MACRO)
01800
01900 (DEFPROP CONST
02000 (LAMBDA (X) (LIST (QUOTE NULL) (LIST (QUOTE CDR) (CADR X))))
02100 MACRO)
02200
02300 (DEFPROP HERE
02400 (LAMBDA (X) (LIST (QUOTE CAAR) (CADR X)))
02500 MACRO)
02600
02700 (DEFPROP VAR
02800 (LAMBDA (L) (LIST (QUOTE NUMBERP) (CADR L)))
02900 MACRO)
03000
03100 (DEFPROP ISCLS
03200 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 1))
03300 MACRO)
03400
03500 (DEFPROP ISCL
03600 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 2))
03700 MACRO)
03800
03900 (DEFPROP ISLIT
04000 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 3))
04100 MACRO)
04200
04300 (DEFPROP ISTRM
04400 (LAMBDA (L) (LIST (QUOTE EQ) (CADR L) 4))
04500 MACRO)
04600
04700 (DEFPROP MKWRD
04800 (LAMBDA (L) (LIST (QUOTE CDDAR) (CADR L)))
04900 MACRO)
05000
05100 (DEFPROP NEG
05200 (LAMBDA (X) (LIST (QUOTE EQ) (QUOTE ESCAPE) (LIST (QUOTE CAR) (CADR X))))
05300 MACRO)
05400
05500 (DEFPROP NEGBIT
05600 (LAMBDA (X) (LIST (QUOTE CDDAAR) (CADR X)))
05700 MACRO)
05800
05900 (DEFPROP POS
06000 (LAMBDA (X) (LIST (QUOTE NOT) (LIST (QUOTE NEG) (CADR X))))
06100 MACRO)
06200
06300 (DEFPROP POSBIT
06400 (LAMBDA (X) (LIST (QUOTE CADAAR) (CADR X)))
06500 MACRO)
06600
06700 (DEFPROP SEARCH
06800 (LAMBDA (X) (LIST (QUOTE SEARCH2) (CADR X) (CADDR X) (CADR X)))
06900 MACRO)
07000
07100 (DEFPROP NEGL
07200 (LAMBDA (C) (LIST (QUOTE CADAR) (CADR C)))
07300 MACRO)
00100
00200 (DE VINE(X)(ATOM(CDR(ANCESTOR X))) )
00300
00400 (DEFPROP ALPHABETIC
00500 (LAMBDA(R L)
00600 (PROG NIL
00700 A (COND ((OR (NULL L) (NULL (CAR L))) (RETURN R))
00800 ((NOT (EQ (LENGTH (CDR R)) (LENGTH (CDAR L)))) (GO B))
00900 ((ALPHAV (CDR R) (CDAR L) NIL) (RETURN (CAR L))))
01000 B (SETQ L (CDR L))
01100 (COND (L (GO A)) (T (RETURN NIL)))))
01200 EXPR)
01300
01400 (DEFPROP ALPHAV
01500 (LAMBDA(C1 C2 L)
01600 (PROG NIL
01700 AL1 (COND ((NULL C1) (RETURN T)) ((NEG (CAR C1)) (GO AL3)) ((NOT (EQ (CAAR C1) (CAAR C2))) (RETURN NIL)))
01800 (SETQ L (ANSUNI (CDAR C1) (CDAR C2) L))
01900 AL2 (COND ((NULL L) (RETURN NIL)))
02000 (SETQ C1 (CDR C1))
02100 (SETQ C2 (CDR C2))
02200 (GO AL1)
02300 AL3 (COND ((POS (CAR C2)) (RETURN NIL))
02400 ((EQ (CADAR C1) (CADAR C2)) (SETQ L (ANSUNI (CDDAR C1) (CDDAR C2) L)) (GO AL2)))
02500 (RETURN NIL)))
02600 EXPR)
02700
02800 (DEFPROP ANSPRED
02900 (LAMBDA NIL (ANSPRINT (STAGE1 (ANSWER (CONS LHP RHP)))))
03000 EXPR)
03100
03200 (DEFPROP ANSPRINT
03300 (LAMBDA(L)
03400 (PROG (Z VARL ONO)
03500 (SETQ ONO 0)
03600 B (PRINC (QUOTE /())
03700 (SETQ Z (CDAR L))
03800 A (COND ((NEG (CAR Z)) (PRFPR1 (CDAR Z))) (T (PRFPR1 (CONS ESCAPE (CAR Z)))))
03900 (SETQ Z (CDR Z))
04000 (COND (Z (PRINC (QUOTE / )) (PRINC (QUOTE ∧)) (PRINC (QUOTE / )) (GO A)))
04100 (PRINC (QUOTE /)))
04200 (SETQ L (CDR L))
04300 (COND (L (PRINC (QUOTE / )) (PRINC (QUOTE ∨)) (PRINC (QUOTE / )) (GO B)))
04400 (RETURN NIL)))
04500 EXPR)
04600
04700 (DEFPROP